home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d16 / prvw12.arc / WOPLUS.PAS < prev   
Pascal/Delphi Source File  |  1991-07-10  |  9KB  |  361 lines
  1. {WOPLUS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit WOPlus;
  3.  
  4.  
  5. {******************************************************************}
  6. { I N T E R F A C E                                                }
  7. {******************************************************************}
  8. interface
  9. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
  10. type
  11. PODButton = ^TODButton;
  12. TODButton = object(TButton)
  13.     HBmp :HBitmap;
  14.    State:Integer;
  15.    constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  16.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  17.    destructor    Done;virtual;
  18.    procedure    DrawItem(var Msg:TMessage);virtual;
  19. end;
  20.  
  21.  
  22. type
  23.     PStackStr = ^TStackStr;
  24.    TStackStr = object(TObject)
  25.        StackStr:PChar;
  26.       constructor Init(NewStr:PChar);
  27.       destructor Done;virtual;
  28.     end;
  29.  
  30. type
  31.     PStack = ^TStack;
  32.     TStack = object(TCollection)
  33.        procedure Push(Item:Pointer);virtual;
  34.       function Pop:Pointer;virtual;
  35.    end;
  36.  
  37.  
  38. {TTextStream}
  39. type
  40. PTextStream = ^TTextStream ;
  41. TTextStream = object(TBufStream)
  42.    CharsToRead : LongInt;
  43.    CharsRead : LongInt;
  44.    ARecord :PChar;
  45.    constructor Init(FileName:PChar;Mode,Size:Word);
  46.    destructor Done;virtual;
  47.    function GetNext:PChar;virtual;
  48.    function WriteNext(szARecord:PChar):integer;virtual;
  49.    function WriteEOF:integer;virtual;
  50.    function IsEOF:Boolean;virtual;
  51.    function GetPctDone:Integer;
  52. end;
  53.  
  54.  
  55. {TMeter}
  56. type
  57.     PMeterWindow = ^TMeterWindow;
  58.    TMeterWindow = object(TWindow)
  59.        TheRedBrush:HBrush;
  60.       TheBlueBrush:Hbrush;
  61.       ThePen:HPen;
  62.       X,Y,dX,dY,mX :Integer;
  63.       PctDone :Integer;
  64.    constructor Init(AParent:PWindowsObject;ATitle:PChar);
  65.    procedure   SetupWindow;virtual;
  66.    destructor  Done; virtual;
  67.    procedure   Draw(NewPctDone:Integer);virtual;
  68.    procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  69. end;
  70.  
  71. {********************************************************************}
  72. {I M P L E M E N T A T I O N                                                     }
  73. {********************************************************************}
  74. implementation
  75.  
  76. {***********************************************************************}
  77.  
  78. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  79.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  80. begin
  81.     TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  82.    Attr.Style := Attr.Style or bs_OwnerDraw;
  83.    HBmp := LoadBitmap(HInstance,BMP);
  84. end;
  85.  
  86. destructor    TODButton.Done;
  87. begin
  88.     TButton.Done;
  89.     DeleteObject(HBmp);
  90. end;
  91.  
  92.  
  93. procedure    TODButton.DrawItem(var Msg:TMessage);
  94. var
  95.     TheDC:HDc;
  96.     ThePen:HPen;
  97.    Pen1:HPen;
  98.    Pen2:HPen;
  99.    TheBrush :HBrush;
  100.    OldBrush :HBrush;
  101.    OldPen:HPen;
  102.    OldBitMap:HBitMap;
  103.    MemDC :HDC;
  104.    LPts:Array[0..2] of TPoint;
  105.    RPts:Array[0..2] of TPoint;
  106.    PDIS :^TDrawItemStruct;
  107.    X,Y,W,H:Integer;
  108. begin
  109.     PDIS := Pointer(Msg.lParam);
  110.    if PDIS^.itemAction = oda_Focus then Exit;
  111.     if ((PDIS^.itemAction and oda_Select ) > 0) and
  112.        ((PDIS^.itemState and ods_Selected) > 0) then
  113.        State := 1 else State := 0; ;
  114.  
  115.    X := PDIS^.rcItem.left;Y := PDIS^.rcItem.top;
  116.    W := PDIS^.rcItem.right-PDIS^.rcItem.left;
  117.    H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
  118.    LPts[0].x := W; LPts[0].y := 0;
  119.    LPts[1].x := 0; LPts[1].y := 0;
  120.    LPts[2].x := 0; LPts[2].y := H;
  121.    RPts[0].x := 0; RPts[0].y := H;
  122.    RPts[1].x := W; RPts[1].y := H;
  123.    RPts[2].x := W; RPts[2].y := 0;
  124.    MemDC := CreateCompatibleDC(PDIS^.HDC);
  125.    OldBitMap := SelectObject(MemDC,HBMP);
  126.    if State = 0 then
  127.        BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
  128.    else
  129.       BitBlt(PDIS^.HDC,X+2,Y+2,W,H, MemDC,0,0,SrcCopy);
  130.    SelectObject(MemDC,OldBitMap);
  131.    DeleteDC(MemDC);
  132.  
  133.     Pen1 := CreatePen(ps_Solid,2,$00000000);
  134.    OldPen := SelectObject(PDIS^.HDC,Pen1);
  135.    PolyLine(PDIS^.HDC,LPts,3);
  136.    PolyLine(PDIS^.HDC,RPts,3);
  137.    SelectObject(PDIS^.HDC,OldPen);
  138.    DeleteObject(Pen1);
  139.  
  140.    LPts[0].x := W-2; LPts[0].y := 2;
  141.    LPts[1].x := 2; LPts[1].y := 2;
  142.    LPts[2].x := 2;LPts[2].y := H-2;
  143.    RPts[0].x := 1; RPts[0].y := H-1;
  144.    RPts[1].x := W-1; RPts[1].y := H-1;
  145.    RPts[2].x := W-1; RPts[2].y := 1;
  146.    if State = 0 then
  147.        begin
  148.         Pen1 := CreatePen(ps_Solid,2,$00FFFFFF);
  149.       Pen2 := CreatePen(ps_Solid,2,$00808080);
  150.       end
  151.    else
  152.        begin
  153.         Pen2 := CreatePen(ps_Solid,1,$00808080);
  154.       Pen1 := CreatePen(ps_Solid,2,$00808080);
  155.       end;
  156.  
  157.    OldPen := SelectObject(PDIS^.HDC,Pen1);
  158.    PolyLine(PDIS^.HDC,LPts,3);
  159.  
  160.    SelectObject(PDIS^.HDC,Pen2);
  161.    DeleteObject(Pen1);
  162.  
  163.    PolyLine(PDIS^.HDC,RPts,3);
  164.    SelectObject(PDIS^.HDC,OldPen);
  165.    DeleteObject(Pen2);
  166.  
  167. end;
  168.  
  169.  
  170. {***********************************************************************}
  171. constructor TStackStr.Init(NewStr:PChar);
  172. begin
  173.     StackStr := StrNew(NewStr);
  174. end;
  175.  
  176. destructor TStackStr.Done;
  177. begin
  178.     StrDispose(StackStr);
  179. end;
  180.  
  181. {***********************************************************************}
  182. procedure TStack.Push(Item:Pointer);
  183. begin
  184.     AtInsert(0,Item);
  185. end;
  186.  
  187. function TStack.Pop:Pointer;
  188. begin
  189.     Pop := At(0);
  190.    AtDelete(0);
  191. end;
  192.  
  193.  
  194. {***********************************************************************}
  195. {TTextStream Methods}
  196. constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
  197. begin
  198.     TBufStream.Init(FileName,Mode,Size);
  199.    CharsRead := 0;
  200.    CharsToRead := TBufStream.GetSize;
  201.    ARecord := MemAlloc(32000);
  202. end;
  203.  
  204. {Done}
  205. destructor TTextStream.Done;
  206. begin
  207.     TBufStream.Done;
  208.    FreeMem(ARecord,32000);
  209. end;
  210.  
  211. {GetNext}
  212. function TTextStream.GetNext:PChar;
  213. var
  214.     Blksize:Integer;
  215.    AChar:Char;
  216.    Indx : Integer;
  217.    IsEOR : Boolean;
  218. begin
  219.    Indx := 0;
  220.    IsEOR := False;
  221.    ARecord[0] := #0;
  222.    while (CharsRead < CharsToRead) and (IsEOR = False) do
  223.    begin
  224.        TBufStream.Read(AChar,1);
  225.       Inc(CharsRead);
  226.       if (AChar = #13) then
  227.           begin
  228.          ARecord[Indx] := #0;
  229.          IsEOR := True;
  230.          end
  231.       else if (AChar = #10) then
  232.           begin
  233.          end
  234.       else if (AChar = #26) then
  235.           begin
  236.          end
  237.       else 
  238.           begin
  239.          ARecord[Indx] := AChar;
  240.          inc(Indx);
  241.          end
  242.    end;
  243.    GetNext := ARecord;
  244. end;
  245.  
  246. {WriteNext}
  247. {This method not actually used due to performance loss - instead
  248.    TStream.Write is called directly}
  249. function TTextStream.WriteNext(szARecord:PChar):Integer;
  250. const
  251.   CRLF : Array[0..2] of Char = #13#10#0;
  252.  
  253. begin
  254.       TBufStream.Write(szARecord,
  255.           StrLen(szARecord));
  256.       TBufStream.Write(CRLF,2);
  257.       WriteNext := StrLen(szARecord);
  258. end;
  259.  
  260. {WriteEOF}
  261. function TTextStream.WriteEOF:Integer;
  262. const
  263.       EOF : Array[0..1] of Char  = #26;
  264. begin
  265.     TBufStream.Write(EOF,1);
  266.    WriteEOF := 1;
  267. end;
  268.  
  269. {IsEOF}
  270. function TTextStream.IsEOF:Boolean;
  271. begin
  272.     IsEOF := False;
  273.    if CharsRead >= CharsToRead then
  274.        IsEOF := True;
  275. end;
  276.  
  277. {GetPctDone}
  278. function TTextStream.GetPctDone:Integer;
  279. begin
  280.     GetPctDone := CharsRead*100 div CharsToRead;
  281. end;
  282.  
  283.  
  284. {**********************************************************************}
  285. {TMeterWindow Methods}
  286. {Init}
  287. constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
  288. begin
  289.     TWindow.Init(AParent,ATitle);
  290.    DisableAutoCreate;
  291.      ThePen := CreatePen(ps_Solid,1,$00000000);
  292.    TheBlueBrush := CreateSolidBrush(RGB(0,0,255));
  293.    TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
  294.    with Attr do
  295.        begin
  296.       X := 100;Y :=100 ;W := 350;H := 75;
  297.       Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
  298.    end;
  299.    X := 50;
  300.    Y := 10;
  301.    dX := 275;
  302.    dY := 30;
  303.    mX := 50;   {midpoint between X & X+dX}
  304.    PctDone := 0;
  305. end;
  306.  
  307. procedure TMeterWindow.SetupWindow;
  308. begin
  309.     TWindow.SetupWindow;
  310. end;
  311.  
  312. {Done}
  313. destructor TMeterWindow.Done;
  314. begin
  315.      DeleteObject(TheBlueBrush);
  316.    DeleteObject(TheRedBrush);
  317.    DeleteObject(ThePen);
  318.    Destroy;
  319.    TWindow.Done;
  320. end;
  321.  
  322. procedure TMeterWindow.Draw(NewPctDone:Integer);
  323. begin
  324.     PctDone := NewPctDone;
  325.     If PctDone > 0 then
  326.        mX :=  X + ((dX * PctDone) div 100)
  327.    else
  328.        mX := X;
  329.    InvalidateRect(HWindow,nil,True);
  330.    UpdateWindow(HWindow);
  331. end;
  332.  
  333. procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  334. var
  335.     OldBrush : HBrush;
  336.    OldPen :HPen;
  337.    OldColor : LongInt;
  338.    OldBkMode : Integer;
  339.    Buf  : Array[0..5] of Char;
  340. begin
  341.     DrawIcon(PaintDC,10,10,GetClassWord(HWindow,GCW_HICON));
  342.    OldPen := SelectObject(PaintDC,ThePen);
  343.    OldBrush := SelectObject(PaintDC,TheRedBrush);
  344.    Rectangle(PaintDC,X,Y,mX,Y+dY);
  345.    SelectObject(PaintDC,TheBlueBrush);
  346.    Rectangle(PaintDC,mX,Y,X+dX,Y+dY);
  347.    Str(PctDone:4, Buf);
  348.    StrCat(Buf,'%');
  349.    OldColor := SetTextColor(PaintDC,$00FFFFFF);  {White}
  350.    OldBkMode := SetBkMode(PaintDC,Transparent);
  351.    TextOut(PaintDC,165,17,Buf,StrLen(Buf));
  352.    SelectObject(PaintDC,OldBrush);
  353.    SelectObject(PaintDC,OldPen);
  354.    SetTextColor(PaintDC,Oldcolor);
  355.    SetBkMode(PaintDC,OldBkMode);
  356. end;
  357.  
  358.  
  359. {***********************************************************************}
  360. end.
  361.